home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / avl-macros.em next >
Text File  |  1992-10-06  |  3KB  |  96 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;
  9. ; File:         avl-macros.em
  10. ; Title:        AVL tree module utility
  11. ; Author:       Julian Padget revised Arthur Norman's code.
  12. ;
  13. ; (c) Copyright 1990, University of Bath, all rights reserved
  14. ;
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16. ;
  17. ; Revisions:
  18. ;  21-APR-90 (Julian Padget)  Code originally comes from Cambridge Lisp and
  19. ;    was written by Arthur Norman.  Mohammed Awdeh and John Fitch made it work
  20. ;    in PSL and JAP tarted it up with defstruct and modules for EuLisp/PSL
  21. ;  09-NOV-90 (Keith Playford) Becomes avl.em for EuLisp compilation. Removed 
  22. ;    progs. Split macros.
  23. ;  10-NOV-90 (Julian Padget) Remmoved avl-prog macro having modified avl.em
  24. ;    to make it superfluous.
  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26.  
  27. (defmodule avl-macros
  28.  
  29. ;;  ( lists list-operators others classes class-names defs) ()
  30.   (lists list-operators others classes defs
  31.    (except (null) class-names))
  32.  
  33.   ()
  34.  
  35.   ; tree node access operators
  36.  
  37.   ; EuLispised (kjp)
  38.  
  39.  ( avl-macros)
  40.  
  41. ;; (export
  42.  
  43.   (ldefstruct key-value ()
  44.     ((key 
  45.        initarg key 
  46.        accessor key)
  47.      (value
  48.        initarg value
  49.        accessor value))
  50.     constructor make-key-value)
  51.  
  52.   (ldefstruct tree ()
  53.     ((key-value-pair 
  54.        initarg key-value-pair
  55.        accessor key-value-pair)
  56.      (avl-left 
  57.        initarg avl-left
  58.        accessor avl-left)
  59.      (avl-right 
  60.        initarg avl-right
  61.        accessor avl-right)
  62.      (balance-state
  63.        initarg balance-state
  64.        accessor balance-state))
  65.     constructor make-tree)
  66.  
  67.   (ldefstruct avl-tree ()
  68.     ((order
  69.        initarg order
  70.        reader avl-tree-order)
  71.      (equality
  72.        initarg equality
  73.        reader avl-tree-equality)
  74.      (tree
  75.        initform ()
  76.        initarg tree
  77.        accessor avl-tree-tree))
  78.     constructor make-avl-tree)
  79.  
  80.   (defmacro avl-key (tree) `(key (key-value-pair ,tree)))
  81.   (defmacro avl-value (tree) `(value (key-value-pair tree)))
  82.   (defmacro avl-balanced (tree) `(eq (balance-state tree) 0))
  83.   (defmacro avl-left-unbalanced (tree) `(eq (balance-state tree) 1))
  84.   (defmacro avl-right-unbalanced (tree) `(eq (balance-state tree) 2))
  85.   (defmacro avl-double-unbalanced (tree) `(eq (balance-state tree) 3))
  86.  
  87.   (defmacro mark-balanced (tree) `((setter balance-state) tree 0))
  88.   (defmacro mark-left-unbalanced (tree) `((setter balance-state) tree 1))
  89.   (defmacro mark-right-unbalanced (tree) `((setter balance-state) tree 2))
  90.   (defmacro mark-double-unbalanced (tree) `((setter balance-state) tree 3))
  91.  
  92. ;; )
  93.  
  94. )
  95.  
  96.